home *** CD-ROM | disk | FTP | other *** search
/ BBS in a Box 7 / BBS in a Box - Macintosh - Volume VII (BBS in a Box) (January 1993).iso / Files / Art / I / IMAGE 1.45.cpt / Macros / More Macros < prev    next >
Text File  |  1992-06-20  |  9KB  |  429 lines
  1. macro 'Invert Image';
  2. {
  3. This macro illustrates why it's not a good idea to use
  4. macros to do pixel-by-pixel processing.
  5. }
  6. var
  7.   width,height,value,x,y:integer;
  8. begin
  9.   RequiredVersion(1.44);
  10.   GetPicSize(width,height);
  11.   for y:=0 to height-1 do begin
  12.     GetRow(0,y,width);
  13.     for x:=0 to width-1 do LineBuffer[x]:=255-LineBuffer[x];
  14.     PutRow(0,y,width);
  15.   end;
  16. end;
  17.  
  18.  
  19. macro 'Remove Isolated Black Lines';
  20. var
  21.   width,height,value,x,y,xstart,ystart:integer;
  22. begin
  23.   GetRoi(xstart,ystart,width,height);
  24.   if width=0 then begin
  25.     PutMessage('This macro requires a retangular selection');
  26.     exit;
  27.   end;
  28.   for y:=ystart to ystart+height-1 do begin
  29.     if GetPixel(width div 2,y)=255 then
  30.       for x:=xstart to xstart+width-1 do
  31.         PutPixel(x,y,(GetPixel(x,y-1)+GetPixel(x,y+1))/2);
  32.   end;
  33.   KillRoi;
  34. end;
  35.  
  36.  
  37. macro 'Make Mosaic';
  38. var
  39.   n:integer;
  40. begin
  41.   SaveState
  42.   n:=GetNumber('Cell Size(pixels square):',8);
  43.   Duplicate('Mosaic');
  44.   SetScaling('Nearest; Same Window');
  45.   ScaleSelection(1/n,1/n);
  46.   RestoreRoi;
  47.   ScaleSelection(n,n);
  48.   RestoreState;
  49. end;
  50.  
  51.  
  52. macro 'Draw Vertical Scale with Labels';
  53. var
  54.   left,top,width,height,i,x,y2,inc:integer;
  55.   y:real;
  56. begin
  57.   GetRoi(left,top,width,height);
  58.   if width=0 then begin
  59.     PutMessage('Make a selection first.');
  60.     exit;
  61.   end;
  62.   SetFont('Helvetica');
  63.   SetFontSize(10);
  64.   SetText('Plain; Left; no background');
  65.   SetLineWidth(1);
  66.   Setforeground(255);
  67.   DrawScale;
  68.   x:=left;
  69.   y:=top;
  70.   inc:=height/10;
  71.   for i:=1 to 11 do begin
  72.     MoveTo(x+width+10,round(y)+2);
  73.     y2:=round(y);
  74.     if i=11 then y2:=y2-1;
  75.     write(cvalue(GetPixel(x,y2)):1:2);
  76.     y:=y+inc;
  77.   end;
  78. end;
  79.  
  80.  
  81. macro 'Speckle Paint [S]';
  82. var
  83.   x,y,ranx,rany,MaxSpeckSize,size,Spread:integer;
  84. begin
  85.   {SaveState;}
  86.   Spread:=50;
  87.   MaxSpeckSize:=5;
  88.   KillRoi;
  89.   repeat
  90.     GetMouse(x,y);
  91.     if button then begin
  92.       ranx:=x+Spread*(Random-0.5);
  93.       rany:=y+Spread*(Random-0.5);
  94.       size:=(MaxSpeckSize-2)*random+2;
  95.       MakeOvalRoi(ranx-size,rany-size,size*2,size*2);
  96.       SetForeground(Random*254+1)
  97.       fill;
  98.     end;
  99.   until (x<0) or (y<0);
  100.   KillRoi;
  101.   {RestoreState;}
  102. end;
  103.  
  104.  
  105. macro 'Draw Histogram';
  106. var
  107.   max,scale:real;
  108.   i,margin,width,height:integer;
  109. begin
  110.   SaveState;
  111.   Margin:=10;
  112.   width:=256;
  113.   height:=0.6*256;
  114.   Measure;
  115.   SetForegroundColor(255);
  116.   SetBackgroundColor(0);
  117.   SetLineWidth(1);
  118.   SetNewSize(width+2*margin,height+2*margin);
  119.   MakeNewWindow('Histogram');
  120.   MakeRoi(margin,margin-1,width,height+1);
  121.   DrawBoundary;
  122.   max:=0;
  123.   for i:=1 to 254 do
  124.   if histogram[i]> max then max:=histogram[i];
  125.   scale:=height/max;
  126.   for i:=1 to 254 do begin
  127.     MakeRoi(margin+i,margin,1,histogram[i]*scale);
  128.     SetForegroundColor(i);
  129.     fill;
  130.  end;
  131.   SelectAll;
  132.   FlipVertical;
  133.   KillRoi;
  134.   RestoreState;
  135. end;
  136.  
  137.  
  138. macro 'Subtract Background [B]';
  139. var
  140.   i,Corrected,smoothf:integer;
  141.   scalef:real;
  142. begin
  143.   scalef:=.125;
  144.   smoothf:=10;
  145.   SelectAll;
  146.   Duplicate('Background Corrected');
  147.   Corrected:=PicNumber;
  148.   Duplicate('Background');
  149.   SetScaling('Bilinear'); 
  150.   ScaleSelection(scalef,scalef);
  151.   RestoreRoi;
  152.   for i:=1 to smoothf do begin
  153.     SetOption; Smooth;
  154.   end;
  155.   ScaleSelection(1/scalef,1/scalef);
  156.   ScaleMath(false);
  157.   SelectAll;
  158.   Copy;
  159.   SelectPic(Corrected);
  160.   Paste;
  161.   Subtract;
  162.   ResetGrayMap;
  163. end;
  164.  
  165.  
  166. macro 'ASCII Dump';
  167. {
  168. Generates an alphanumeric listing of pixels values starting at
  169. the upper left corner of the current selection. 20 rows and 44 columns
  170. can be displayed with the default 552 x 436 window. The size of the window
  171. used to display the pixel values is determined by New Width and
  172. New Height in the Prefernces dialog box.
  173. }
  174. var
  175.   image,dump,roiLeft,roiTop,roiWidth,roiHeight:integer;
  176.   h,v,value,MaxWidth,MaxHeight,width,height:integer;
  177. begin
  178.   image:=PicNumber;
  179.   GetRoi(RoiLeft,RoiTop,RoiWidth,RoiHeight);
  180.   if roiWidth=0 then begin
  181.     PutMessage('This macro requires a rectangular selection');
  182.     exit;
  183.   end;
  184.   SetForegroundColor(255);
  185.   SetBackgroundColor(0);
  186.   MakeNewWindow('ASCII Dump');
  187.   dump:=PicNumber;
  188.   GetPicSize(width,height);
  189.   MaxWidth:=width div 24 - 2;
  190.   MaxHeight:=height div 9 - 3;
  191.   if roiWidth>MaxWidth then roiWidth:=MaxWidth;
  192.   if roiHeight>MaxHeight then roiHeight:=MaxHeight;
  193.   SetFont('Monaco');
  194.   SetFontSize(9);
  195.   SetText('No background; Left Justified');
  196.   MoveTo(2,12);
  197.   write('    ');
  198.   for h:=roiLeft to roiLeft+roiWidth-1 do write(h:4);
  199.   writeln;
  200.   writeln;
  201.   for v:=roiTop to roiTop+roiHeight-1 do begin
  202.     write(v:3,' ');
  203.     for h:=roiLeft to roiLeft+roiWidth-1 do begin
  204.       ChoosePic(image);
  205.       value:=GetPixel(h,v);
  206.       ChoosePic(dump);
  207.       write(value:4);
  208.     end;
  209.     writeln;
  210.   end;
  211.   ChoosePic(image);
  212. end;
  213.  
  214.  
  215. macro 'Resize All';
  216. {
  217. Resizes and/or rotates all currently open widows. For example,
  218. change the  ScaleAndRotate command below to
  219. ScaleAndRotate(2,2,0)  to change the size of all the images
  220. in a movie loop sequence from 128 x 128 to 256 x 256.
  221. }
  222. var
  223.   i:integer;
  224. begin
  225.   SaveState;
  226.   SetScaling('Bilinear; Create New Window');
  227.   for i:=1 to nPics do begin
  228.     ChoosePic(1);
  229.     ScaleAndRotate(1.9,1.9,0);
  230.     ChoosePic(1);
  231.     Close;
  232.   end;
  233.   for i:=1 to nPics do begin
  234.     ChoosePic(i);
  235.     SetPicName(i);
  236.   end;
  237.   RestoreState;
  238. end;
  239.  
  240.  
  241. macro 'Dispose All';
  242. begin
  243.   DisposeAll;
  244. end;
  245.  
  246. macro 'Average two Images';
  247.   {Generates the arithmetic average of two images.}
  248. begin
  249.   if nPics<>2 then begin
  250.     PutMessage('This macro requires exactly two image windows to be open.');
  251.     Exit;
  252.   End;
  253.   ScaleMath(false);
  254.   MultiplyByConstant(0.5);
  255.   NextWindow;
  256.   MultiplyByConstant(0.5);
  257.   SelectAll;
  258.   Copy;
  259.   NextWindow;
  260.   Paste;
  261.   Add;
  262. end;
  263.  
  264.  
  265. macro 'Make Montage [M]';
  266. {Opens a new window and creates in it a composite image made from all}
  267. {currently open images. All the images must be the same size.}
  268. var
  269.   width,height,w,h,mWidth,mHeight,nWindows,left,top:integer;
  270.   RoiWidth,RoiHeight,RoiWidth,RoiHeight,i,hloc,vloc:integer;
  271.   montage,temp:integer;
  272.   scale:real;
  273.   SameSize:boolean;
  274. begin
  275.   nWindows:=nPics;
  276.   SameSize:=true;
  277.   GetPicSize(width,height);
  278.   for i:=1 to nPics do begin
  279.     SelectPic(i);
  280.     GetPicSize(w,h);
  281.     SameSize:=SameSize and (w=width) and (h=height);
  282.   end;
  283.   if (nWindows<2) or not SameSize then begin
  284.     PutMessage('This macro needs two or more images of the same size in order to create a montage.');
  285.     Exit;
  286.   end;
  287.   SetBackground(0);
  288.   MakeNewWindow('Montage');
  289.   montage:=nWindows+1;
  290.   GetPicSize(mWidth,mHeight);
  291.   SelectPic(1);
  292.   Duplicate('Temp');
  293.   temp:=nWindows+2;
  294.   scale:=GetNumber('Scaling Factor:',0.25);
  295.   hloc:=-(RoiWidth);
  296.   vloc:=0;
  297.   for i:=1 to nWindows do begin
  298.     SelectPic(i);
  299.     SelectAll;
  300.     copy;
  301.     SelectPic(temp);
  302.     paste;
  303.     SelectAll;
  304.     ScaleSelection(scale,scale);
  305.     RestoreRoi;
  306.     if i=1 then begin
  307.       GetRoi(left,top,RoiWidth,RoiHeight);
  308.       hloc:=-RoiWidth;
  309.       vloc:=0;
  310.     end;
  311.     Copy;
  312.     SelectPic(montage);
  313.     hloc:=hloc+RoiWidth;
  314.     if (hloc+RoiWidth)>mWidth then begin
  315.       hloc:=0;
  316.       vloc:=vloc+RoiHeight;
  317.     end;
  318.     MakeRoi(hloc,vloc,RoiWidth,RoiHeight);
  319.     Paste;
  320.   end;
  321.   KillRoi;
  322.   SelectPic(temp);
  323.   Dispose;
  324. end;
  325.  
  326.  
  327. macro 'Make Sine Wave';
  328. var
  329.   left,top,width,height,i:integer;
  330.   ppp,scale:real;
  331. begin
  332.   SaveState;
  333.   MakeNewWindow('Sine Wave');
  334.   SelectAll;
  335.   GetRoi(left,top,Width,Height);
  336.   if width=0 then begin
  337.     PutMessage('This macro requires a rectangular selection.');
  338.     Exit;
  339.   end;
  340.   ppp:=GetNumber('Pixels per period',100);
  341.   Scale:=ppp/6.28;
  342.   MakeRoi(left,top,1,height);
  343.   for i:=1 to width do begin
  344.     SetForeground(sin(i/scale)*127 +128);
  345.     {SetForeground((sin(i/scale)*127 +128)*(i+30)/(width));}
  346.     {SetForeground(sin(i/(ppp*((width-i+3)/width)/6.28))*127 +128);}
  347.     fill;
  348.     MoveRoi(1,0);
  349.   end;
  350.   KillRoi;
  351.   RestoreState;
  352. end;`
  353.  
  354.  
  355. macro 'Grid';
  356. var
  357.   n,PicWidth,PicHeight,hloc,vloc,size:integer;
  358. begin
  359.   SaveState;
  360.   n:=24;
  361.   GetPicSize(PicWidth,PicHeight);
  362.   if PicWidth=0 then begin
  363.     PutMessage
  364.     ('This macro needs an opened image, preferably in color, to operate on.');
  365.     Exit;
  366.   end;
  367.   size:=round(PicWidth/n);
  368.   repeat
  369.     hloc:=((PicWidth*random) div size)*size;
  370.     vloc:=((PicHeight*random) div size)*size;
  371.     MakeRoi(hloc,vloc,size,size);
  372.     SetForeground(255*random);
  373.     fill;
  374.     {Invert;}
  375.   until Button;
  376.   KillRoi;
  377.   RestoreState;
  378. end;
  379.  
  380.  
  381. macro 'Plot XYZ';
  382. {
  383. Plots X-Y coordinate points with an optional intensity(Z). Values are read from
  384. a 2 or 3 column tab-delimited text file. Data must be scaled as follows:
  385. 0<=X<width; 0<=Y<height; 0<=Z<=255.
  386. }
  387. var
  388.   width,height:integer;
  389. begin
  390.   width:=450;
  391.   height:=500;
  392.   SetNewSize(width,height);
  393.   MakeNewWindow('Plot');
  394.   PlotXYZ;
  395. end;
  396.  
  397.  
  398. macro '(---'; begin end;
  399.  
  400. macro '5x5 [5]';
  401. {
  402. Note: you only see the open file dialog box the first time one of
  403. these macros is called, since Image keeps track of the folder
  404. containing the convolution kernels.
  405. }
  406. begin
  407.   convolve('Hat(5x5)');
  408. end;
  409.  
  410. macro '7x7  [7]'
  411. begin
  412.   convolve('Hat(7x7)');
  413. end;
  414.  
  415. macro '9x9  [9]'
  416. begin
  417.   convolve('Hat(9x9)');
  418. end;
  419.  
  420.  
  421. macro '(---'; begin end;
  422.  
  423. {These macros allow you to easily switch}
  424. {transfer modes while pasting by tapping keys.}
  425. macro 'Copy Mode[F1]'; begin SetOption; DoCopy; end;
  426. macro 'AND Mode[F2]';  begin SetOption; DoAnd; end;
  427. macro 'OR Mode [F3]';  begin SetOption; DoOr; end;
  428.  
  429.